disag_locale <- full %>%
select(school_id, locale = exclusive_locale, starts_with("practices")) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(locale, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(locale) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:5)## `summarise()` has grouped output by 'locale'. You can override using the
## `.groups` argument.
# urban
urban_plot <- disag_locale %>%
filter(locale == "Urban") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Urban Schools",
x = "",
y = "percentage of urban schools")
urban_plot# suburban
suburban_plot <- disag_locale %>%
filter(locale == "Suburban") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Suburban Schools",
x = "",
y = "percentage of suburban schools")
suburban_plot# rural
rural_plot <- disag_locale %>%
filter(locale == "Rural") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Rural Schools",
x = "",
y = "percentage of rural schools")
rural_plot# mixed
mixed_plot <- disag_locale %>%
filter(locale == "Multiple") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools Serving\nStudents from all Geographic Locales",
x = "",
y = "percentage of mixed schools")
mixed_plot#prekindergarten
disag_pk <- full %>%
select(school_id, grades_prek, starts_with("practices")) %>%
filter(grades_prek == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Pre-Kindergarten Schools",
x = "",
y = "percentage of prek schools")
disag_pk# elementary schools
disag_elem <- full %>%
select(school_id, grades_elementary, starts_with("practices")) %>%
filter(grades_elementary == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Elementary Schools",
x = "",
y = "percentage of elementary schools")
disag_elem#middle schools
disag_middle <- full %>%
select(school_id, grades_middle, starts_with("practices")) %>%
filter(grades_middle == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Middle Schools",
x = "",
y = "percentage of middle schools")
disag_middle#high schools
disag_high <- full %>%
select(school_id, grades_high, starts_with("practices")) %>%
filter(grades_high == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in High Schools",
x = "",
y = "percentage of high schools")
disag_highdisag_type <- full %>%
select(school_id, type = school_descriptor, starts_with("practices")) %>%
mutate(type = case_when(
type == 1 ~ "District",
type == 2 ~ "Charter",
type == 3 ~ "Independent"
)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(type, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(type) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:5)## `summarise()` has grouped output by 'type'. You can override using the
## `.groups` argument.
#Public district schools
district_plot <- disag_type %>%
filter(type == "District") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Public District Schools",
x = "",
y = "percentage of district schools")
district_plot#Public charter schools
charter_plot <- disag_type %>%
filter(type == "Charter") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Public Charter Schools",
x = "",
y = "percentage of charter schools")
charter_plot#Independent schools
independent_plot <- disag_type %>%
filter(type == "Independent") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Independent (Private) Schools",
x = "",
y = "percentage of independent schools")
independent_plotThese plots are somewhat misleading and probably should not be displayed due to low N. For homeschools in particular, because there were only 4 schools that described themselves that way and 6 instances where they all selected the same tags, the plot displays a full 100% barchart for all 6 tags. Drawing any conclusions from this would not be a good idea, though.
For reference: homeschool N = 4
hybrid N = 21
microschool N =
school-within-school N =
*virtual N =
#homeschool
disag_homeschool <- full %>%
select(school_id, homeschool = school_descriptor_homeschool, starts_with("practices")) %>%
filter(homeschool == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because #5 had a tie with another practice -6 tags had 100% selection
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Homeschools",
subtitle = "Interpret with caution: only 4 homeschools",
x = "",
y = "percentage of homeschools")
disag_homeschool#hybrid
disag_hybrid <- full %>%
select(school_id, hybrid = school_descriptor_hybrid, starts_with("practices")) %>%
filter(hybrid == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:4) %>% #pulled 4 because 7 tags shared #5 spot
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Hybrid Schools",
x = "",
y = "percentage of hybrid schools")
disag_hybrid#microschool
disag_micro <- full %>%
select(school_id, micro = school_descriptor_microschool, starts_with("practices")) %>%
filter(micro == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>% #top 5 had same rate of selection (87%)
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Microschools",
subtitle = "The top 5 tags selected for microschools shared the same\nrate of selection",
x = "",
y = "percentage of microschools")
disag_micro#school within school
disag_sws <- full %>%
select(school_id, sws = school_descriptor_sws, starts_with("practices")) %>%
filter(sws == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because tie at spot #5
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools-within-schools",
x = "",
y = "percentage of school-within-schools")
disag_swsI collapsed leadership team diversity variable in two:
predominantly White = 0-49% BIPOC leadership
predominantly BIPOC = 50% + BIPOC leadership
disag_lead <- full %>%
select(school_id, lead = leadership_diversity, starts_with("practices")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "PWI",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(lead) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:6) #tie at spot #5 for both groups## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.
#predominantly white
pwled_plot <- disag_lead %>%
filter(lead == "PWI") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools led\nby Predominantly White\nLeadership Team",
x = "",
y = "percentage of schools")
pwled_plot#BIPOC-led
bipocled_plot <- disag_lead %>%
filter(lead == "BIPOC") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools led\nby Predominantly BIPOC\nLeadership Team",
x = "",
y = "percentage of schools")
bipocled_plot## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
The plots below pull from all schools that selected
design to meet the needs of students who have been marginalized
and the follow-up question which asks them to specify which
marginalized student group they are designing for.
The chart below displays the frequency with which Canopy learning environments identified specific student groups as the historically marginalized groups they’re designing their schools for.
marg_freq <- full %>%
select(starts_with("focus"), practices_design_marginalized) %>% #191/251 schools selected
select(!focus_other_student_group_text) %>%
filter(practices_design_marginalized == 1) %>%
mutate(rate = rep(1, nrow(.))) %>%
summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
pivot_longer(cols = starts_with("focus"),
names_to = "group",
values_to = "n") %>%
mutate(pct = n/rate,
group = case_when(
group == "focus_bipoc" ~ "BIPOC students",
group == "focus_economic_disadvantage" ~ "Economically Disadvantaged Students",
group == "focus_emergent_bilingual" ~ "Students Classified as English Learners",
group == "focus_foster" ~ "Students in the Foster Care System",
group == "focus_homeless" ~ "Students Experiencing Houselessness",
group == "focus_interrupted" ~ "Students with Interrupted Formal Education",
group == "focus_juvenile_justice" ~ "Students in the Juvenile Justice System",
group == "focus_multilingual" ~ "Multilingual Students",
group == "focus_newcomer" ~ "Newcomer and Recently Arrived Students",
group == "focus_other_student_group" ~ "Other",
group == "focus_swd" ~ "Students with Disabilities"
)) %>%
ggplot(., aes(reorder(group, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "When schools are designing for margianlized groups,\nwhich groups are they designing for?",
x = "",
y = "percentage of schools indicating designing for specific student groups")
marg_freq## Warning in labels(...): Missing tag label
disag_ml <- full %>%
select(school_id, ml = focus_multilingual, starts_with("practices")) %>%
filter(ml == 1) %>%
select(!practices_design_marginalized) %>% #dropping since all will have chosen
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because tie at spot #5
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools Designing for Multilingual students",
x = "",
y = "percentage of schools")
disag_mlOf the schools indicating they were designing specifically for multilingual learners, 18% utilized dual language programming and 13% offered heritage language instruction for their multilingual students. These schools also leverage translanguaging (14%) at double the rate observed in our overall Canopy sample.
#all MLLs
ml<-
full %>%
select(practices_dual_language, practices_heritage_language, practices_translanguaging, focus_multilingual) %>%
filter(focus_multilingual == 1) %>% #111 schools focus on MLLs
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
group_by(tag) %>%
summarize(n = sum(n),
pct = paste0(round(100*(n/111)), "%"))
datatable(ml)The same pattern holds when observing schools designing specifically for students classified as English Learners, though the rates are slightly lower for dual language programming and heritage language instruction.
#ELs specifically
el <-
full %>%
select(practices_dual_language, practices_heritage_language, practices_translanguaging, focus_emergent_bilingual) %>%
filter(focus_emergent_bilingual == 1) %>% #111 schools focus on MLLs
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
group_by(tag) %>%
summarize(n = sum(n),
pct = paste0(round(100*(n/111)), "%"))
datatable(el)Comparative chart
not = data.frame(tag = c("practices_dual_language", "practices_heritage_language", "practices_translanguaging"),
n = c(31, 17, 19),
pct = c(12, 7, 8),
focus = rep("none", 3))
comp_ml <- ml %>%
mutate(focus = rep("MLL", nrow(.))) %>%
bind_rows(el) %>%
mutate(focus = replace_na(focus, "EL")) %>%
mutate(pct = str_remove_all(pct, "[:punct:]"),
pct = as.numeric(pct)) %>%
bind_rows(not) %>%
mutate(pct = pct/100) %>%
ggplot(., aes(tag, pct, fill = focus)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.x = element_blank()) +
scale_fill_manual(values = transcend_cols,
labels=c('Students Classified as English Learners', 'All Multilingual Students', 'None')) +
labs(title = "Language-Related Practices Used by Schools Focusing on Multilingual Learners",
x = "",
y = "") +
scale_x_tag() +
theme(legend.position = c(.75,.85))
# geom_text(aes(group = focus, label = scales::label_percent(accuracy = 1)(pct)),
# nudge_y = .01,
# vjust = 0,
# color = "black",
# fontface = "bold",
# size = 5,
# family = "sans")
comp_mlI collapsed leadership team diversity variable in two:
predominantly White = 0-49% BIPOC leadership
predominantly BIPOC = 50% + BIPOC leadership
core_lead <- full %>%
select(school_id, lead = leadership_diversity, starts_with("core")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "PWI",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(lead) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:6) #tie at spot #5 for one group## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.
#all top 6:
#practices_pbl
#practices_culturally_responsive
#practices_restorative
#practices_sel_integrated
#practices_all_courses_designed_for_inclusion
#practices_design_marginalized
#practices_competency_education
#practices_community_partnerships
#practices_learning_paths
#practices_career_prep
#predominantly white
pwcore_plot <- core_lead %>%
filter(lead == "PWI") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Core Practices in Schools\nled by Predominantly\nWhite Leadership Team",
x = "",
y = "percentage of schools")
pwcore_plot#BIPOC-led
bipoccore_plot <- core_lead %>%
filter(lead == "BIPOC") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Core Practices in Schools\nled by Predominantly\nBIPOC Leadership Team",
x = "",
y = "percentage of schools")
bipoccore_plot# ggsave("finding-17b.png", plot = combined_core, path = here("final_products", "draft-findings"),
# width = 12, height = 8, units = "in")Alternate plot: biggest differences in tagging between PW & BIPOC leaders
labs = c("Difference = 14%", "", "Difference = 13%", "", "Difference = 12%","", "Difference = 11%","", "Difference = 10%","", "Difference = 10%","", "Difference = 9%","", "Difference = 8%","", "Difference = 8%", "", "Difference = 6%", "")
diff_core <- full %>%
select(school_id, lead = leadership_diversity, starts_with("core")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "White",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = lead,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_BIPOC - pct_White), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "Leadership Team"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = `Leadership Team`)) +
geom_bar(position = "dodge", stat = "identity") +
scale_y_continuous(limits = c(0, .55), expand = c(0,0), labels = scales::percent) +
# bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>predominantly <span style = 'color: #1A4C81;'>BIPOC</span> and <span style = 'color: #EF464B;'>White</span> Leadership Teams",
subtitle = "When Canopy schools select the practices they use,they also have the option to\nselect up to 5 practices they consider central to their learning environment.\nThe comparison below displays the difference for the 5 practices schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none") +
geom_text(aes(y = .4, label = labs),
color = transcend_grays[1],
family = "sans",
size = 4)## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.
We should look at modeling results to draw any strong conclusions, but I’ve created a barplot below displaying the biggest tagging differences between the two groups for the core tags selected.
I defined “inclusive” as those schools that indicated they were either designing for the needs of marginalized student groups or have all courses designed for inclusion.
Analyst note I do not trust the plot below - simple difference in tagging is good to see, however, the number of schools that fell into the “inclusive” bucket (N = 217) was far bigger than those that were not (N = 34). Might be good to think more about how to account for such a difference in sample.
inclusive_diff <-
full %>%
select(school_id, inc = practices_all_courses_designed_for_inclusion, marg = practices_design_marginalized, starts_with("core")) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
select(!c(practices_all_courses_designed_for_inclusion, practices_design_marginalized)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.
ggsave("finding-20.png", plot = inclusive_diff, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")inclusive_diff3 <-
full %>%
select(school_id, inc = core_all_courses_designed_for_inclusion, marg = core_design_marginalized, starts_with("practices")) %>%
select(!c(practices_all_courses_designed_for_inclusion, practices_design_marginalized)) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
subtitle = "This plot displays the 5 core tags schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.
inclusive_diff2 <-
full %>%
select(school_id, inc = core_all_courses_designed_for_inclusion, marg = core_design_marginalized, starts_with("core")) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.
ggsave("finding-20a-V2.png", plot = inclusive_diff2, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")#model usage
model_usage<-
full %>%
select(school_id, starts_with("model")) %>%
mutate(any = case_when(
model_usage_bpl == 2 ~ 1,
model_usage_ele == 2 ~ 1,
model_usage_ib == 2 ~ 1,
model_usage_ntn == 2 ~ 1,
model_usage_oc == 2 ~ 1,
model_usage_sl == 2 ~ 1
)) %>%
select(school_id, any) %>%
unique() %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(any) %>%
summarize(sum = sum(rate, na.rm = TRUE),
pct = sum/251)